Kapitel 6 Textvergleich
6.1 Programi
Nameščanje programov (Packages) Namestitev: Če ste program(e) že namestili, lahko preskočite ta korak.
Znak # v programskem bloku (chunk) pomeni, da se ta vrstica ne izvaja. Odstrani # če želite program namestiti.
# # Programe, ki jih še nimate, lahko namestite tudi na ta način (odstranite #):
# install.packages("readtext")
# ...
## First specify the packages of interest
packages = c("tidyverse", "quanteda", "quanteda.textplots",
"quanteda.textstats", "wordcloud2", "tidytext",
"udpipe", "janitor", "scales", "widyr", "syuzhet",
"corpustools", "readtext")
# Install packages not yet installed
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Packages loading
invisible(lapply(packages, library, character.only = TRUE))Najprej moramo zagnati programe, ki jih potrebujemo za načrtovano delo.
library(readtext)
library(quanteda)
library(quanteda.textstats)
library(quanteda.textplots)
library(tidyverse)
library(tidytext)
library(wordcloud2)
library(udpipe)
library(janitor)
library(scales)
library(widyr)
library(syuzhet)
library(corpustools)6.2 Preberemo besedila
txt = readtext("data/books/*.txt", encoding = "UTF-8")
txt## readtext object consisting of 2 documents and 0 docvars.
## # Description: df [2 x 2]
## doc_id text
## <chr> <chr>
## 1 prozess.txt "\"Der Prozes\"..."
## 2 tom.txt "\"Tom Sawyer\"..."
Alternativno lahko besedila preberemo tudi z medmrežja:
txt1 = readtext("https://raw.githubusercontent.com/tpetric7/tpetric7.github.io/main/data/books/prozess.txt", encoding = "UTF-8")
txt2 = readtext("https://raw.githubusercontent.com/tpetric7/tpetric7.github.io/main/data/books/tom.txt", encoding = "UTF-8")
# Datoteki združimo
txt = rbind(txt1,txt2)6.3 Ustvarimo korpus
Ustvarimo korpus ali jezikovno gradivo. Ukaz v programu “quanteda” je corpus().
romane = corpus(txt)Povzetek:
Program quanteda ima dve funkciji za povzemanje: - summary() - textstat_summary()
(romanstatistik = textstat_summary(romane)
)## document chars sents tokens types puncts numbers symbols urls tags emojis
## 1 prozess.txt 482722 3845 88010 7907 16380 10 0 0 0 0
## 2 tom.txt 460249 4652 85841 9860 18785 9 0 0 0 0
povzetek = summary(romane)
povzetek## Corpus consisting of 2 documents, showing 2 documents:
##
## Text Types Tokens Sentences
## prozess.txt 8507 88010 3845
## tom.txt 10551 85841 4652
Podatke iz povzetka bi lahko uporabili npr. za izračun povprečne dolžine povedi v besedilih:
povzetek %>%
group_by(Text) %>%
mutate(dolzina_povedi = Tokens/Sentences)## # A tibble: 2 x 5
## # Groups: Text [2]
## Text Types Tokens Sentences dolzina_povedi
## <chr> <int> <int> <int> <dbl>
## 1 prozess.txt 8507 88010 3845 22.9
## 2 tom.txt 10551 85841 4652 18.5
Lahko bi tudi izračunali kazalnik slovarske raznolikosti v besedilih, tj. razmerje med različnimi (types) in pojavnicami (tokens), kar se angleščini imenuje “type token ratio” (ttr).
Razlikujemo med slovarskimi enotami (lemma), različnicami (types) in pojavnicami (tokens):
npr. nemški glagol “gehen” je slovarska enota, ki ima več različnic ali oblik (npr. gehe, gehst, geht, gehen, geht, ging, gingst, … gegangen).
Pojavnice: nekatere oblike glagola so pogostejše kot druge, nekatere pa se v izbranem besedilu ne pojavljajo.
povzetek %>%
group_by(Text) %>%
mutate(ttr = Types/Tokens)## # A tibble: 2 x 5
## # Groups: Text [2]
## Text Types Tokens Sentences ttr
## <chr> <int> <int> <int> <dbl>
## 1 prozess.txt 8507 88010 3845 0.0967
## 2 tom.txt 10551 85841 4652 0.123
Program quanteda ima za ugotavljanje slovarske raznolikosti (lexical diversity) več možnosti, kar zahteva razcepitev besedil na manjše enote, tj. tokens (besede, ločila idr.). Za nekatere funkcije moramo ustvariti besedilno matriko (document frequency matrix, dfm).
6.4 Tokenizacija
Če želimo več izvedeti o besedilih, npr. katere besede se pojavljajo v besedilih, moramo najprej ustvariti seznam besedilnih enot (tj. besed, ločil idr.).
Iz gradiva izvlečemo besedne oblike (npr. s pomočjo presledkov).
Za tokenizacijo ima quanteda ukaz tokens().
besede = tokens(romane)
head(besede)## Tokens consisting of 2 documents.
## prozess.txt :
## [1] "Der" "Prozess" "by"
## [4] "Franz" "Kafka" "Aligned"
## [7] "by" ":" "bilingual-texts.com"
## [10] "(" "fully" "reviewed"
## [ ... and 87,998 more ]
##
## tom.txt :
## [1] "Tom" "Sawyer" "by" "Mark"
## [5] "Twain" "Aligned" "by" ":"
## [9] "András" "Farkas" "(" "autoalignment"
## [ ... and 85,829 more ]
6.5 Čiščenje
S seznama lahko izločimo “nebesede”:
besede = tokens(romane, remove_punct = T, remove_symbols = T, remove_numbers = T, remove_url = T)
head(besede)## Tokens consisting of 2 documents.
## prozess.txt :
## [1] "Der" "Prozess" "by"
## [4] "Franz" "Kafka" "Aligned"
## [7] "by" "bilingual-texts.com" "fully"
## [10] "reviewed" "Der" "Prozess"
## [ ... and 71,608 more ]
##
## tom.txt :
## [1] "Tom" "Sawyer" "by" "Mark"
## [5] "Twain" "Aligned" "by" "András"
## [9] "Farkas" "autoalignment" "Source" "Project"
## [ ... and 67,035 more ]
Izločimo lahko tudi besede, ki za vsebinsko analizo niso zaželene (“stopwords”).
V izbranih besedilih motijo tudi angleške besede, ki niso sestavni del nemških besedil.
concatenate = združi: c()
stoplist_de = c(stopwords("de"), "dass", "Aligned", "by", "autoalignment", "Source", "Project",
"bilingual-texts.com", "fully", "reviewed")
besede = tokens_select(besede, pattern = stoplist_de, selection = "remove")Naslednji seznam bomo uporabljali za ustvarjanje konkordance, tj. seznama sobesedil, v katerem se nahaja iskalni niz (npr. neka beseda).
stoplist_en = c("Aligned", "by", "autoalignment", "Source", "Project",
"bilingual-texts.com", "fully", "reviewed")
# Obdržali bomo ločila
woerter = tokens(romane, remove_symbols = T, remove_numbers = T, remove_url = T)
# Odstranili bomo angleške besede na začetku besedil
woerter = tokens_select(woerter, pattern = stoplist_en, selection = "remove", padding = TRUE)6.6 Kwic
Za sestavo konkordanc ima program quanteda funkcijo kwic() (keyword in context).
Možno je iskati posamezne besede, besedne zveze, uporabljamo pa lahko tudi nadomestne znake (npr. *).
kwic(woerter, pattern = c("Frau", "Herr")) %>% head(3)## Keyword-in-context with 3 matches.
## [prozess.txt, 22] Kafka Verhaftung, Gespräch mit | Frau |
## [prozess.txt, 54] verhaftet. Die Köchin der | Frau |
## [prozess.txt, 96] seinem Kopfkissen aus die alte | Frau |
##
## Grubach, dann Fräulein Brüstner
## Grubach, seiner Zimmervermieterin,
## , die ihm gegenüber wohnte
Konkordanco bomo pretvorili v podatkovno zbirko, tj. data.frame ali tibble(). Prednost je npr., da tako pridobimo imena stolpcev (tj. spremenljivk).
kwic() ima več možnosti, npr. “case_insensitive = FALSE” razlikuje med velikimi in malimi črkami. Privzeta vrednost je “TRUE,” tj. da tega ne razlikuje (tako kot Excel).
konkordanca = kwic(woerter, pattern = c("Frau", "Herr"), case_insensitive = FALSE) %>%
as_tibble()
konkordanca %>% rmarkdown::paged_table()Z ukazom count() lahko preštejemo, koliko pojavnic je KWIC našel.
konkordanca %>%
count(keyword)## # A tibble: 2 x 2
## keyword n
## <chr> <int>
## 1 Frau 132
## 2 Herr 94
Poiskati želimo besede s pripono “-in” za samostalnike, ki označujejo ženska osebna imena (npr. Ärztin, Köchin, …).
(konkordanca2 = kwic(woerter, pattern = c("*in"), case_insensitive = FALSE) %>%
as_tibble()
)## # A tibble: 4,100 x 7
## docname from to pre keyword post pattern
## <chr> <int> <int> <chr> <chr> <chr> <fct>
## 1 prozess.txt 26 26 mit Frau Grubach , dann Fräulein Brüst~ *in
## 2 prozess.txt 52 52 eines Morgens verhaftet . Die Köchin der F~ *in
## 3 prozess.txt 58 58 der Frau Grubach , seiner Zimmerv~ , die~ *in
## 4 prozess.txt 86 86 . K . wartete noch ein Weilc~ *in
## 5 prozess.txt 129 129 . Sofort klopfte es und ein Mann ~ *in
## 6 prozess.txt 134 134 ein Mann , den er in diese~ *in
## 7 prozess.txt 143 143 niemals gesehen hatte , trat ein . Er ~ *in
## 8 prozess.txt 155 155 fest gebaut , er trug ein anlie~ *in
## 9 prozess.txt 292 292 zur Tür , die er ein wenig~ *in
## 10 prozess.txt 322 322 das Frühstück bringt . « Ein klein~ *in
## # ... with 4,090 more rows
Žal vsebuje gornji seznam sobesedil veliko besednih oblik, ki niso ženska osebna imena (npr. ein, in, …). Če želimo natančnejši seznam, moramo iskati na ustreznejši način, npr. z naborom nadomestnih znakov, tako imeovanih regularnih izrazov (regular expressions, “regex”).
Na portalu https://regex101.com/ lahko preizkušate in se učite regularnih izrazov.
Poizvedovanje s pomočjo regularnih izrazov: *in.
konkordanca2 = kwic(woerter, pattern = "\\A[A-Z][a-z]+[^Eae]in\\b",
valuetype = "regex", case_insensitive = FALSE) %>%
as_tibble() %>%
filter(keyword != "Immerhin",
keyword != "Darin",
keyword != "Termin",
keyword != "Worin",
keyword != "Robin",
keyword != "Medizin",
keyword != "Austin",
keyword != "Musselin",
keyword != "Benjamin",
keyword != "Franklin")
konkordanca2 %>% rmarkdown::paged_table()Še drug primer uporabe regularnih izrazov Poizvedovanje s pomočjo regex: Manjšalnice / Diminutive (-chen, -lein). Katera manjšalna pripona prevladuje: -lein ali -chen ?
(konkordanca3a = kwic(woerter, "*lein",
valuetype = "glob", case_insensitive = FALSE) %>%
as_tibble() %>%
count(keyword, sort = TRUE)
)## # A tibble: 6 x 2
## keyword n
## <chr> <int>
## 1 Fräulein 112
## 2 allein 49
## 3 klein 10
## 4 Allein 2
## 5 Äuglein 1
## 6 Schreibmaschinenfräulein 1
(konkordanca3b <- kwic(woerter, "*chen",
valuetype = "glob", case_insensitive = FALSE) %>%
as_tibble() %>%
count(keyword, sort = T)
)## # A tibble: 415 x 2
## keyword n
## <chr> <int>
## 1 machen 125
## 2 Mädchen 100
## 3 sprechen 57
## 4 bißchen 44
## 5 zwischen 43
## 6 solchen 38
## 7 Weilchen 33
## 8 Zeichen 31
## 9 Menschen 30
## 10 Burschen 28
## # ... with 405 more rows
(konkordanca3 <- kwic(woerter,
pattern = c("\\A[A-Z][a-z]*[^aäeiouürs]chen\\b",
"[A-Z]*[^kl]lein\\b"),
valuetype = "regex", case_insensitive = FALSE) %>%
as_tibble() %>%
filter(keyword != "Welchen",
keyword != "Manchen",
keyword != "Solchen",
keyword != "Fräulein")
)## # A tibble: 74 x 7
## docname from to pre keyword post pattern
## <chr> <int> <int> <chr> <chr> <chr> <fct>
## 1 prozess.txt 87 87 K . wartete noch ein Weilchen , sah ~ "\\A[A-~
## 2 prozess.txt 750 750 warf das Buch auf ein Tischch~ und st~ "\\A[A-~
## 3 prozess.txt 1740 1740 aufgeschreckt , die bei dem Tischch~ am off~ "\\A[A-~
## 4 prozess.txt 2617 2617 , stand K . ein Weilchen lang s~ "\\A[A-~
## 5 prozess.txt 3323 3323 Stuhl und hielt ihn ein Weilchen mit be~ "\\A[A-~
## 6 prozess.txt 3624 3624 hatte . Jetzt war das Nachtti~ von ih~ "\\A[A-~
## 7 prozess.txt 3799 3799 Gegenstände , die auf dem Nachtti~ lagen ~ "\\A[A-~
## 8 prozess.txt 5805 5805 sagte K . nach einem Weilchen und re~ "\\A[A-~
## 9 prozess.txt 6952 6952 , das früh auf dem Tischch~ beim F~ "\\A[A-~
## 10 prozess.txt 10539 10539 . » Darf ich das Nachtti~ von Ih~ "\\A[A-~
## # ... with 64 more rows
Poizvedovanje s pomočjo “regex”: Frau + Priimek / Ime
Obvezno nastavimo case_insensitive = FALSE, saj naj program razlikuje med velikimi in malimi začetnicami.
(konkordanca4 <- kwic(woerter, pattern = phrase("\\bFrau\\b ^[A-Z][^[:punct:]]"),
valuetype = "regex", case_insensitive = FALSE) %>%
as_tibble()
)## # A tibble: 61 x 7
## docname from to pre keyword post pattern
## <chr> <int> <int> <chr> <chr> <chr> <fct>
## 1 prozess.txt 22 23 Kafka Verhaft~ Frau Gru~ , dann Fräule~ "\\bFrau\\b ~
## 2 prozess.txt 54 55 verhaftet . D~ Frau Gru~ , seiner Zimm~ "\\bFrau\\b ~
## 3 prozess.txt 416 417 im Nebenzimme~ Frau Gru~ diese Störung~ "\\bFrau\\b ~
## 4 prozess.txt 551 552 Es war das Wo~ Frau Gru~ , vielleicht ~ "\\bFrau\\b ~
## 5 prozess.txt 700 701 . » Ich will ~ Frau Gru~ - « , sagte K "\\bFrau\\b ~
## 6 prozess.txt 1647 1648 gerade die ge~ Frau Gru~ wollte dort e~ "\\bFrau\\b ~
## 7 prozess.txt 2868 2869 war , so konn~ Frau Gru~ als Zeugin fü~ "\\bFrau\\b ~
## 8 prozess.txt 5960 5961 . Im Vorzimme~ Frau Gru~ , die gar nic~ "\\bFrau\\b ~
## 9 prozess.txt 6557 6558 in der ganzen~ Frau Gru~ verursacht wo~ "\\bFrau\\b ~
## 10 prozess.txt 6852 6853 , aber da er ~ Frau Gru~ sprechen woll~ "\\bFrau\\b ~
## # ... with 51 more rows
6.7 Pogostnost
Besedilno-besedna matrika (dfm) je izhodišče za izračun in grafični prikaz več statističnih količin, npr. tudi pogostnosti besednih oblik v posameznih besedilih:
matrika = dfm(besede, tolower = FALSE) # za zdaj obdržimo velike začetnice
# Odstranimo besede, ki jih v vsebinski analizi ne potrebujemo (stopwords)
matrika = dfm_select(matrika, selection = "remove", pattern = stoplist_de)
matrika## Document-feature matrix of: 2 documents, 15,185 features (39.73% sparse) and 0 docvars.
## features
## docs Prozess Franz Kafka Verhaftung Gespräch Frau Grubach Fräulein
## prozess.txt 2 24 2 18 16 114 50 112
## tom.txt 0 0 0 0 4 18 0 0
## features
## docs Brüstner Jemand
## prozess.txt 1 2
## tom.txt 0 1
## [ reached max_nfeat ... 15,175 more features ]
Program quanteda ima posebno funkcijo, ki sestavi seznam besednih oblik in njihove pogostnosti, tj. textstat_frequency().
library(quanteda.textstats)
library(quanteda.textplots)
pogostnost = textstat_frequency(matrika, groups = c("prozess.txt", "tom.txt"))
pogostnost %>% rmarkdown::paged_table()Diagram najpogostnejših izrazov:
pogostnost %>%
slice_max(order_by = frequency, n = 20) %>%
mutate(feature = reorder_within(feature, frequency, frequency, sep = ": ")) %>%
# ggplot(aes(frequency, reorder(feature, frequency))) +
ggplot(aes(frequency, feature)) +
geom_col(fill="steelblue") +
labs(x = "Frequency", y = "") +
facet_wrap(~ group, scales = "free")Po potrebi lahko seznam besednih pogostnosti oblik razdelimo na dva posebna seznama, in sicer s funkcijo filter().
pogost_tom = textstat_frequency(matrika, groups = c("prozess.txt", "tom.txt")) %>%
filter(group == "tom.txt")
pogost_tom %>% rmarkdown::paged_table()pogost_prozess = textstat_frequency(matrika, groups = c("prozess.txt", "tom.txt")) %>%
filter(group == "prozess.txt")
pogost_prozess %>% rmarkdown::paged_table()Glagoli rekanja in mišljenja: kateri so v izbranih besedilih pogostnejši?
sagen = pogostnost %>%
filter(str_detect(feature, "^(ge)?sag*"))
sagen %>% rmarkdown::paged_table()reden = pogostnost %>%
filter(str_detect(feature, "^(ge)?rede*"))
reden %>% rmarkdown::paged_table()fragen = pogostnost %>%
filter(str_detect(feature, "^(ge)?frag*"))
fragen %>% rmarkdown::paged_table()antworten = pogostnost %>%
filter(str_detect(feature, "^(ge)?antwort*"))
antworten %>% rmarkdown::paged_table()rufen = pogostnost %>%
filter(str_detect(feature, pattern = "^(ge)?ruf*", negate = FALSE)) %>%
filter(!str_detect(feature, "ruh|run|rum|rui|ruch"))
rufen %>% rmarkdown::paged_table()verb1 = sagen %>%
group_by(group) %>%
summarise(freq = sum(frequency)) %>%
mutate(verb = "sagen")
verb2 = reden %>%
group_by(group) %>%
summarise(freq = sum(frequency)) %>%
mutate(verb = "reden")
verb3 = fragen %>%
group_by(group) %>%
summarise(freq = sum(frequency)) %>%
mutate(verb = "fragen")
verb4 = antworten %>%
group_by(group) %>%
summarise(freq = sum(frequency)) %>%
mutate(verb = "antworten")
verb5 = rufen %>%
group_by(group) %>%
summarise(freq = sum(frequency)) %>%
mutate(verb = "rufen")Pet majhnih tabel lahko združimo v večjo tabelo, tj. s funkcijo rbind().
glagoli = rbind(verb1, verb2, verb3, verb4, verb5)
glagoli %>% rmarkdown::paged_table()Še diagram:
glagoli %>%
ggplot(aes(freq, verb, fill = verb)) +
geom_col() +
facet_wrap(~ group) +
theme(legend.position = "none")Tabelo lahko tudi prerazporedimo, npr. zaradi lažje primerjave besedil takole:
glagoli %>%
pivot_wider(id_cols = verb, names_from = group, values_from = freq) %>% rmarkdown::paged_table()6.8 Kolokacije
Koleksemi = slovarske enote, ki se sopojavljajo. Kolokacije = jezikovne prvine, ki se sopojavljajo.
Statistična opredelitev: Če se dva izraza (npr. “dober dan”) pojavljata bistveno pogosteje kot neposredna soseda, kakor bi naključno pričakovali, potem ju lahko obravnavamo kot kolokacijo.
Jezikoslovna opredelitev: Kolokacija je pomensko povezano zaporedje besed.
Funkcija textstat_collocations() v programu quanteda.
“woerter” je seznam besednih oblik (padding = TRUE !), ki smo ga ustvarili zgoraj.
coll_2 = textstat_collocations(woerter, size = 2, tolower = TRUE) # naredi male črke !
coll_2 %>% rmarkdown::paged_table()Kolokacije s tremi členi.
coll_3 = textstat_collocations(woerter, size = 3, tolower = FALSE)
coll_3 %>% rmarkdown::paged_table()coll_4 = textstat_collocations(woerter, size = 4, tolower = FALSE)
coll_4 %>% rmarkdown::paged_table()Sopomenski vprašalnici “warum” in "wieso: s katerimi besednimi oblikami se sopojavljata?
warum <- coll_2 %>%
filter(str_detect(collocation, "^warum"))
warum %>% rmarkdown::paged_table()wieso <- coll_2 %>%
filter(str_detect(collocation, "^wieso"))
wieso %>% rmarkdown::paged_table()Kolokacija samostalniških izrazov. V nemščini imajo veliko začetnico. Najprej bomo sestavili seznam besednih oblik z veliko začetnico (woerter_caps). Potem lahko pridobimo seznam kolokacij (coll_caps2).
woerter_caps = tokens_select(woerter, pattern = "^[A-Z]",
valuetype = "regex",
case_insensitive = FALSE,
padding = TRUE)
coll_caps2 = textstat_collocations(woerter_caps, size = 2, tolower = FALSE, min_count = 5)
coll_caps2 %>% rmarkdown::paged_table()Ni smiselno upoštevati “Der + samostalnik” kot kolokacijo, saj se v nemščini velika večina samostalnikov pojavlja s členom.
Zato bomo člene “Der, Die, Das” in še nekaj besednih oblik na začetku stavka spremenili v “der, die , das,” ….
woerter_small = tokens_replace(woerter,
pattern = c("Der","Die","Das","Des","Wollen","Im","Zum",
"Kein","Jeden","Wenn","Als","Da","Aber","Und","Sehen"),
replacement = c("der","die","das","des","wollen","im","zum",
"kein","jeden","wenn","als","da","aber","und","sehen"))
woerter_caps = tokens_select(woerter_small, pattern = "^[A-Z]",
valuetype = "regex",
case_insensitive = FALSE,
padding = TRUE)
coll_caps2 = textstat_collocations(woerter_caps, size = 2, tolower = FALSE, min_count = 5)
coll_caps2 %>% rmarkdown::paged_table()6.9 Lematizacija
Seznam slovarskih enot (lem) lahko naložimo z medmrežja na naš disk.
# Preberi seznam slovarskih enot in pojavnic z diska
lemdict = read.delim2("data/lemmatization_de.txt", sep = "\t", encoding = "UTF-8",
col.names = c("lemma", "word"), stringsAsFactors = F)
# Pretvori podatkovna niza v znakovna niza
lemma = as.character(lemdict$lemma)
word = as.character(lemdict$word)
# Lematiziraj pojavnice v naših besedilih
lemmas <- tokens_replace(besede,
pattern = word,
replacement = lemma,
case_insensitive = TRUE,
valuetype = "fixed")Ustvarimo matriko s slovarskimi enotami (namesto pojavnic).
matrika_lem = dfm(lemmas, tolower = FALSE) # za zdaj obdržimo velike začetnice
# Odstranimo besede, ki jih v vsebinski analizi ne potrebujemo (stopwords)
matrika_lem = dfm_select(matrika_lem, selection = "remove", pattern = stoplist_de)
matrika_lem## Document-feature matrix of: 2 documents, 10,072 features (38.04% sparse) and 0 docvars.
## features
## docs Prozess franzen Kafka Verhaftung Gespräch Frau Grubach Fräulein
## prozess.txt 2 24 2 19 18 121 50 112
## tom.txt 0 0 0 0 5 27 0 0
## features
## docs Brüstner Jemand
## prozess.txt 1 2
## tom.txt 0 1
## [ reached max_nfeat ... 10,062 more features ]
6.10 Besedni oblaček
textplot_wordcloud(matrika_lem, comparison = TRUE, adjust = 0.3, color = c("darkblue","darkgreen"),
max_size = 4, min_size = 0.75, rotation = 0.5, min_count = 30, max_words = 250)Lepši oblaček (za obe besedili skupaj).
# install.packages("wordcloud2)
matrika_lem_prozess = matrika_lem[1,]
set.seed(1320)
library(wordcloud2)
topfeat <- as.data.frame(topfeatures(matrika_lem_prozess, 100))
topfeat <- rownames_to_column(topfeat, var = "word")
wordcloud2(topfeat)matrika_lem_tom = matrika_lem[2,]
set.seed(1321)
library(wordcloud2)
topfeat2 <- as.data.frame(topfeatures(matrika_lem_tom, 100))
topfeat2 <- rownames_to_column(topfeat2, var = "word")
wordcloud2(topfeat2)6.11 Položaj v besedilu (xray)
Diagram prikazuje, kje v besedilih se pojavlja besedna oblika “frau.” Podobno: Voyant Tools (MicroSearch).
kwic_frau = kwic(lemmas, pattern = "frau")
textplot_xray(kwic_frau)6.12 Slovarska raznolikost
textstat_lexdiv(matrika, measure = "all")## document TTR C R CTTR U S K
## 1 prozess.txt 0.2457355 0.8651285 44.68334 31.59590 33.50861 0.9039511 22.63899
## 2 tom.txt 0.2939104 0.8828536 54.69657 38.67631 38.75057 0.9176397 11.76995
## I D Vm Maas lgV0 lgeV0
## 1 26.76129 0.002233722 0.04626902 0.1727515 7.795478 17.94975
## 2 73.92612 0.001148154 0.03284439 0.1606427 8.533417 19.64892
6.13 Podobnost besedil
Ta postopek je bolj zanimiv, če želimo primerjati več besedil. Zato bomo dodali še Kafkino novelo.
# odpremo datoteko
verwandl = readtext("data/books/verwandlung/verwandlung.txt", encoding = "UTF-8")
# ustvarimo nov korpus
verw_corp = corpus(verwandl)
# združimo novi korpus s prrejšnjim
romane3 = romane + verw_corp
# tokenizacija
romane3_toks = tokens(romane3)
# ustvarimo matriko (dfm)
romane3_dfm = dfm(romane3_toks)Rezultat: Kafkina novela “Die Verwandlung” je Kafkinemu romanu “Der Prozess” nekoliko podobnejša kot Twainov roman “Tom Sawyer.”
textstat_simil(romane3_dfm, method = "cosine", margin = "documents")## textstat_simil object; method = "cosine"
## prozess.txt tom.txt verwandlung.txt
## prozess.txt 1.000 0.930 0.948
## tom.txt 0.930 1.000 0.933
## verwandlung.txt 0.948 0.933 1.000
Podobnost oblik (features).
# compute some term similarities
simil1 = textstat_simil(matrika, matrika[, c("Josef", "Tom", "Sawyer", "Huck", "Finn")],
method = "cosine", margin = "features")
head(as.matrix(simil1), 10)## Josef Tom Sawyer Huck Finn
## Prozess 0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Franz 0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Kafka 0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Verhaftung 0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Gespräch 0.9793983 0.2425356 0.2425356 0.2425356 0.2425356
## Frau 0.9933995 0.1559626 0.1559626 0.1559626 0.1559626
## Grubach 0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Fräulein 0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Brüstner 0.9991331 0.0000000 0.0000000 0.0000000 0.0000000
## Jemand 0.9122695 0.4472136 0.4472136 0.4472136 0.4472136
Različnost besedil (Kaj je ta metoda upoštevala? Razliko v dolžini?):
# plot a dendrogram after converting the object into distances
dist1 = textstat_dist(romane3_dfm, method = "euclidean", margin = "documents")
plot(hclust(as.dist(dist1)))6.14 Ključne besede
Katere besedne oblike lahko uvrstimo med ključne besede, tj. take izraze, ki so najbolj značilni za neko besedilo? Program quanteda ima funkcijo textstat_keyness(): ciljno besedilo (target) primerjamo z referenčnim besedilom (reference).
key_tom <- textstat_keyness(matrika, target = "tom.txt")
key_tom %>% rmarkdown::paged_table()key_prozess <- textstat_keyness(matrika, target = "prozess.txt")
key_prozess %>% rmarkdown::paged_table()textplot_keyness(key_tom, key_tom$n_target == 1)textplot_keyness(key_tom, key_prozess$n_target == 1)textplot_keyness(key_tom)textplot_keyness(key_prozess)6.15 Razumljivost besedil
Indeksi razumljivosti (readability index) so prirejeni za angleščino, za druge jezike veljajo v manjši meri.
Flesch-Indeks: Prozess ima nekoliko nižjo vrednost (52) kot Tom Sawyer (61), kar pomeni, da Prozess (zaradi daljših povedi in besed) težje beremo (razumemo), Tom Sawyer pa z večjo lahkoto.
textstat_readability(romane, measure = c("Flesch", "Flesch.Kincaid", "FOG", "FOG.PSK", "FOG.NRI"))## document Flesch Flesch.Kincaid FOG FOG.PSK FOG.NRI
## 1 prozess.txt 51.94715 10.644645 13.04497 6.390374 8545.508
## 2 tom.txt 60.58142 8.395483 10.61185 5.074038 6016.218
6.16 Omrežje sopojavitev (FCM)
Matriko sopojavljanja besednih oblik (FCM) pridobimo v dveh korakih: - najprej izberemo seznam izrazov (pattern) iz matrike (dfm), - potem določimo matriko sopojavljanja besednih oblik (fcm).
dfm_tags <- dfm_select(matrika[2,], pattern = (c("tom", "huck", "*joe", "becky", "tante", "witwe",
"polly", "sid", "mary", "thatcher", "höhle", "herz",
"*schule", "katze", "geld", "zaun", "piraten",
"schatz")))
toptag <- names(topfeatures(dfm_tags, 50))
head(toptag)## [1] "Tom" "Huck" "Joe" "Becky" "Tante" "Sid"
# Construct feature-cooccurrence matrix (fcm) of tags
fcm_tom <- fcm(matrika[2,]) # besedilo 2 je tom.txt
head(fcm_tom)## Feature co-occurrence matrix of: 6 by 15,185 features.
## features
## features Prozess Franz Kafka Verhaftung Gespräch Frau Grubach Fräulein
## Prozess 0 0 0 0 0 0 0 0
## Franz 0 0 0 0 0 0 0 0
## Kafka 0 0 0 0 0 0 0 0
## Verhaftung 0 0 0 0 0 0 0 0
## Gespräch 0 0 0 0 6 72 0 0
## Frau 0 0 0 0 0 153 0 0
## features
## features Brüstner Jemand
## Prozess 0 0
## Franz 0 0
## Kafka 0 0
## Verhaftung 0 0
## Gespräch 0 4
## Frau 0 18
## [ reached max_nfeat ... 15,175 more features ]
top_fcm <- fcm_select(fcm_tom, pattern = toptag)
textplot_network(top_fcm, min_freq = 0.6, edge_alpha = 0.8, edge_size = 5)6.17 Slovnična analiza
Za slovnično analizo in lematizacijo besednih oblik lahko uporabljamo posebne programe (npr. spacyr ali udpipe).
Program udpipe je na voljo za številne jezike, tudi za nemščino in slovenščino.
6.17.1 Priprava
Pred prvo uporabo moramo naložiti model za nemški jezik z interneta. V naslednjem koraku naložimo jezikovni model v pomnilnik: udpipe_load_model()
library(udpipe)
destfile = "german-gsd-ud-2.5-191206.udpipe"
if(!file.exists(destfile)){
sprachmodell <- udpipe_download_model(language = "german")
udmodel_de <- udpipe_load_model(sprachmodell$file_model)
} else {
file_model = destfile
udmodel_de <- udpipe_load_model(file_model)
}Če je jezikovni model že v naši delovni mapi, download ni potreben, saj ga lahko takoj naložimo z diska v pomnilnik:
Naslednji korak je udpipe_annotate(): program udpipe označuje besedne oblike po več merilih.
Udpipe prebere in označuje besedilo takole:
# Na začetku je readtext prebral besedila, shranili smo jih v spremenljivki "txt".
x <- udpipe_annotate(udmodel_de, x = txt$text, trace = TRUE)## 2021-09-27 13:18:16 Annotating text fragment 1/2
## 2021-09-27 13:20:04 Annotating text fragment 2/2
# # samo prvo besedilo:
# x <- udpipe_annotate(udmodel_de, x = txt$text[1], trace = TRUE)
x <- as.data.frame(x)Zgradba podatkovnega niza (structure of data frame):
str(x)## 'data.frame': 174925 obs. of 14 variables:
## $ doc_id : chr "doc1" "doc1" "doc1" "doc1" ...
## $ paragraph_id : int 1 1 1 1 1 1 1 1 1 1 ...
## $ sentence_id : int 1 1 1 1 1 1 1 1 1 1 ...
## $ sentence : chr "Der Prozess by Franz Kafka Aligned by : bilingual-texts.com ( fully reviewed ) Der Prozess Franz Kafka 1 Verhaf"| __truncated__ "Der Prozess by Franz Kafka Aligned by : bilingual-texts.com ( fully reviewed ) Der Prozess Franz Kafka 1 Verhaf"| __truncated__ "Der Prozess by Franz Kafka Aligned by : bilingual-texts.com ( fully reviewed ) Der Prozess Franz Kafka 1 Verhaf"| __truncated__ "Der Prozess by Franz Kafka Aligned by : bilingual-texts.com ( fully reviewed ) Der Prozess Franz Kafka 1 Verhaf"| __truncated__ ...
## $ token_id : chr "1" "2" "3" "4" ...
## $ token : chr "Der" "Prozess" "by" "Franz" ...
## $ lemma : chr "der" "Prozeß" "by" "Franz" ...
## $ upos : chr "DET" "NOUN" "PROPN" "PROPN" ...
## $ xpos : chr "ART" "NN" "NE" "NE" ...
## $ feats : chr "Case=Nom|Definite=Def|Gender=Masc|Number=Sing|PronType=Art" "Case=Nom|Gender=Masc|Number=Sing" "Case=Nom|Gender=Masc|Number=Sing" "Case=Nom|Gender=Masc|Number=Sing" ...
## $ head_token_id: chr "2" "72" "2" "3" ...
## $ dep_rel : chr "det" "nsubj" "appos" "flat" ...
## $ deps : chr NA NA NA NA ...
## $ misc : chr NA NA NA NA ...
Podatkovni niz ima tako obliko:
head(x, 10) %>% rmarkdown::paged_table()6.17.2 Primerjava Noun : Pron
Zdaj lahko začnemo poizvedovati po besednih oblikah, slovarskih enotah in slovničnih kategorijah.
(tabela = x %>%
group_by(doc_id) %>%
count(upos) %>%
filter(!is.na(upos),
upos != "PUNCT")
)## # A tibble: 28 x 3
## # Groups: doc_id [2]
## doc_id upos n
## <chr> <chr> <int>
## 1 doc1 ADJ 5284
## 2 doc1 ADP 6350
## 3 doc1 ADV 8387
## 4 doc1 AUX 4390
## 5 doc1 CCONJ 2425
## 6 doc1 DET 8050
## 7 doc1 NOUN 10705
## 8 doc1 NUM 155
## 9 doc1 PART 1984
## 10 doc1 PRON 11280
## # ... with 18 more rows
tabela %>%
mutate(upos = reorder_within(upos, n, n, sep = ": ")) %>%
ggplot(aes(n, upos, fill = upos)) +
geom_col() +
facet_wrap(~ doc_id, scales = "free") +
theme(legend.position = "none") +
labs(x = "Število pojavnic", y = "")Izračun deležev v odstotkih:
(delezi = tabela %>%
mutate(prozent = n/sum(n)) %>%
pivot_wider(id_cols = upos, names_from = doc_id, values_from = n:prozent)
)## # A tibble: 14 x 5
## upos n_doc1 n_doc2 prozent_doc1 prozent_doc2
## <chr> <int> <int> <dbl> <dbl>
## 1 ADJ 5284 5539 0.0729 0.0818
## 2 ADP 6350 5524 0.0877 0.0816
## 3 ADV 8387 6706 0.116 0.0990
## 4 AUX 4390 3386 0.0606 0.0500
## 5 CCONJ 2425 3270 0.0335 0.0483
## 6 DET 8050 6888 0.111 0.102
## 7 NOUN 10705 10871 0.148 0.160
## 8 NUM 155 306 0.00214 0.00452
## 9 PART 1984 1658 0.0274 0.0245
## 10 PRON 11280 9027 0.156 0.133
## 11 PROPN 2317 3919 0.0320 0.0579
## 12 SCONJ 1687 1296 0.0233 0.0191
## 13 VERB 9401 8669 0.130 0.128
## 14 X 20 678 0.000276 0.0100
delezi %>%
filter(upos %in% c("NOUN", "PRON"))## # A tibble: 2 x 5
## upos n_doc1 n_doc2 prozent_doc1 prozent_doc2
## <chr> <int> <int> <dbl> <dbl>
## 1 NOUN 10705 10871 0.148 0.160
## 2 PRON 11280 9027 0.156 0.133
Ali se besedili razlikujeta glede na razmerje med samostalniki in zaimki?
# za hi kvadrat test potrebujemo le drugi in tretji stolpec
nominal = delezi %>%
filter(upos %in% c("NOUN", "PRON")) %>%
dplyr::select(n_doc1, n_doc2)
chisq.test(nominal)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: nominal
## X-squared = 147.38, df = 1, p-value < 2.2e-16
Besedili se razlikujeta glede razmerja med samostalniki in zaimki: X^2 (1) = 147,38; p < 0,001. Iz gornje tabele pogostnosti je razvidno, da je delež zaimkov v romanu “Prozess” sorazmerno večji kot v romanu “Tom Sawyer.” Da bi ugotovili, kaj to pomeni, bi si morali podrobneje ogledati, kateri zaimki in kateri samostalniki bistveno vplivajo na to številčno razmerje. Na splošno velja, da so zaimki manj zanesljiva jezikovna sredstva kot samostalniki, samostalniki pa so bolj zapleteni.
Če želimo primerjati eno besedno vrsto z vsemi drugimi v podatkovnem nizu, je pretvorba bolj zapletena, saj moramo podobno kot v Excelu - najprej izračunati vsoto za vse besedne vrste, - potem odšteti število zaimkov oz. samostalnikov od vsote, - razliko pa upoštevati za tabelo 2x2 za hi kvadrat test.
(zaimki = x %>%
group_by(doc_id) %>%
count(upos) %>%
filter(!is.na(upos),
upos != "PUNCT") %>%
mutate(vsota = sum(n),
no_noun = vsota - n[upos == "NOUN"],
no_pron = vsota - n[upos == "PRON"]) %>%
filter(upos == "PRON") %>%
dplyr::select(doc_id, n, no_pron) %>%
pivot_longer(-doc_id, 'kategorija', 'vrednost') %>%
pivot_wider(kategorija, doc_id)
)## # A tibble: 2 x 3
## kategorija doc1 doc2
## <chr> <int> <int>
## 1 n 11280 9027
## 2 no_pron 61155 58710
(samostalniki = x %>%
group_by(doc_id) %>%
count(upos) %>%
filter(!is.na(upos),
upos != "PUNCT") %>%
mutate(vsota = sum(n),
no_noun = vsota - n[upos == "NOUN"],
no_pron = vsota - n[upos == "PRON"]) %>%
filter(upos == "NOUN") %>%
dplyr::select(doc_id, n, no_noun) %>%
pivot_longer(-doc_id, 'kategorija', 'vrednost') %>%
pivot_wider(kategorija, doc_id)
)## # A tibble: 2 x 3
## kategorija doc1 doc2
## <chr> <int> <int>
## 1 n 10705 10871
## 2 no_noun 61730 56866
Hi kvadrat testa: - primerjava števila zaimkov nasproti ostalim besednim vrstam, - primerjava števila samostalnikov nasproti ostalim besednim vrstam.
# izločimo prvi stolpec [, -1], za hi kvadrat test potrebujemo le drugi in tretji stolpec
chisq.test(zaimki[,-1])##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: zaimki[, -1]
## X-squared = 142.36, df = 1, p-value < 2.2e-16
chisq.test(samostalniki[,-1])##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: samostalniki[, -1]
## X-squared = 43.259, df = 1, p-value = 4.796e-11
Besedili se razlikujeta glede deleža zaimkov in samostalnikov.
6.17.3 Primerjava veznikov
Primerjati želimo število stavkov s prirednim in podrednim veznikom.
Osnovna domneva je, da priredno zložene povedi (vsebujejo stavek, uveden s prirednim veznikom) lažje razumemo kot podredno zložene povedi (vsebujejo stavek, uveden s podrednim veznikom).
(vezniki = tabela %>%
filter(upos %in% c("CCONJ", "SCONJ")) %>%
mutate(prozent = n/sum(n)) %>%
pivot_wider(id_cols = upos, names_from = doc_id, values_from = n:prozent)
)## # A tibble: 2 x 5
## upos n_doc1 n_doc2 prozent_doc1 prozent_doc2
## <chr> <int> <int> <dbl> <dbl>
## 1 CCONJ 2425 3270 0.590 0.716
## 2 SCONJ 1687 1296 0.410 0.284
Odstotki nakazujejo, da je v romanu Prozess delež prirednih veznikov manjši kot v romanu Tom Sawyer.
Hi kvadrat test (upoštevane so le povedi, ki vsebujejo veznik) za preverjanje, ali je razlika dovolj velika, da bi bila nenaključna.
chisq.test(vezniki[,c(2:3)])##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: vezniki[, c(2:3)]
## X-squared = 152.74, df = 1, p-value < 2.2e-16
Razlika med romanoma je statistično značilna.
Če upoštevamo tudi vsote drugih besednih vrst (kot zgoraj):
(koord = tabela %>%
mutate(vsota = sum(n),
no_cconj = vsota - n[upos == "CCONJ"],
no_sconj = vsota - n[upos == "SCONJ"]) %>%
filter(upos == "CCONJ") %>%
dplyr::select(doc_id, n, no_cconj) %>%
pivot_longer(-doc_id, 'kategorija', 'vrednost') %>%
pivot_wider(kategorija, doc_id)
)## # A tibble: 2 x 3
## kategorija doc1 doc2
## <chr> <int> <int>
## 1 n 2425 3270
## 2 no_cconj 70010 64467
(subord = tabela %>%
mutate(vsota = sum(n),
no_cconj = vsota - n[upos == "CCONJ"],
no_sconj = vsota - n[upos == "SCONJ"]) %>%
filter(upos == "SCONJ") %>%
dplyr::select(doc_id, n, no_sconj) %>%
pivot_longer(-doc_id, 'kategorija', 'vrednost') %>%
pivot_wider(kategorija, doc_id)
)## # A tibble: 2 x 3
## kategorija doc1 doc2
## <chr> <int> <int>
## 1 n 1687 1296
## 2 no_sconj 70748 66441
Hi kvadrat preizkus izkazuje razliko med romanoma
chisq.test(koord[,-1])##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: koord[, -1]
## X-squared = 196.24, df = 1, p-value < 2.2e-16
chisq.test(subord[,-1])##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: subord[, -1]
## X-squared = 28.843, df = 1, p-value = 7.849e-08
Besedili se razlikujeta glede števila veznikov.
6.17.4 Slovarske enote
Program udpipe je vsako besedno obliko dodelil slovarski enoti (lemma). Koliko koliko slovarskih enot je v besedilih? Katerim besednim vrstam najpogosteje pripadajo?
(tabela2 = x %>%
group_by(doc_id, upos) %>%
filter(!is.na(upos),
upos != "PUNCT",
upos != "X") %>%
distinct(lemma) %>%
count(lemma) %>%
summarise(lemmas = sum(n)) %>%
mutate(prozent = round(lemmas/sum(lemmas), 4)) %>%
arrange(-prozent)
)## # A tibble: 26 x 4
## # Groups: doc_id [2]
## doc_id upos lemmas prozent
## <chr> <chr> <int> <dbl>
## 1 doc2 NOUN 3401 0.361
## 2 doc1 NOUN 2519 0.352
## 3 doc1 VERB 1696 0.237
## 4 doc1 ADJ 1528 0.213
## 5 doc2 VERB 1934 0.206
## 6 doc2 ADJ 1875 0.199
## 7 doc2 PROPN 973 0.103
## 8 doc1 ADV 605 0.0845
## 9 doc2 ADV 671 0.0713
## 10 doc1 PROPN 387 0.054
## # ... with 16 more rows
tabela2 %>%
# slice_max(order_by = prozent, n=6) %>%
mutate(upos = reorder_within(upos, lemmas, paste("(",100*prozent,"%)"), sep = " ")) %>%
ggplot(aes(prozent, upos, fill = upos)) +
geom_col() +
facet_wrap(~ doc_id, scales = "free") +
theme(legend.position = "none") +
scale_x_continuous(labels = percent_format()) +
labs(x = "Anteil", y = "Wortklasse")6.17.5 Korelacija besed
Katere besedne pogostnosti se vzporedno povečujejo ali zmanjšujejo (pairwise correlation) ? Podobno analizno orodje: Voyant Tools.
library(widyr)
# pairwise correlation
(correlations = x %>%
filter(dep_rel != "punct", dep_rel != "nummod") %>%
mutate(lemma = tolower(lemma), token = tolower(token),
lemma = str_trim(lemma), token = str_trim(token)) %>%
janitor::clean_names() %>%
group_by(doc_id, lemma, token, sentence_id) %>%
# add_count(token) %>%
summarize(Freq = n()) %>%
arrange(-Freq) %>%
filter(Freq > 2) %>%
pairwise_cor(lemma, sentence_id, sort = TRUE) %>%
filter(correlation < 1 & correlation > 0.3)
)## # A tibble: 2,592 x 3
## item1 item2 correlation
## <chr> <chr> <dbl>
## 1 verteidigung natürlich 0.865
## 2 natürlich verteidigung 0.865
## 3 stellvertreter direktor 0.812
## 4 direktor stellvertreter 0.812
## 5 bürstner fräulein 0.741
## 6 fräulein bürstner 0.741
## 7 master jim 0.706
## 8 depot jim 0.706
## 9 eimer jim 0.706
## 10 glaskugel jim 0.706
## # ... with 2,582 more rows
Tom Sawyer: Zaun.
correlations %>%
filter(item1 == "zaun") %>%
mutate(item2 = fct_reorder(item2, correlation)) %>%
ggplot(aes(item2, correlation, fill = item2)) +
geom_col(show.legend = F) +
coord_flip() +
labs(title = "What tends to appear with 'Zaun'?",
subtitle = "Among elements that appeared in at least 2 sentences")Prozess: Gericht.
correlations %>%
filter(item1 == "gericht") %>%
mutate(item2 = fct_reorder(item2, correlation)) %>%
ggplot(aes(item2, correlation, fill = item2)) +
geom_col(show.legend = F) +
coord_flip() +
labs(title = "What tends to appear with 'Gericht'?",
subtitle = "Among elements that appeared in at least 2 sentences")6.18 Sentiment
Stopnjo čustvenosti ali emocionalnosti besedila je mogoče določiti s sentimentnim slovarjem.
6.18.1 Različica 1
Uporaba nrc leksikona za nemščino (priložen programu syuzhet).
Najprej besedilo s funkcijo get_sentences() razcepimo na povedi.
library(syuzhet)
tom_v = get_sentences(txt$text[2]) # izberemo drugo besedilo: tom.txt
tom_v = (tom_v[-1]) # tako lahko izločimo prvo vrstico (uredniško pripombo)
head(tom_v[-1])## [1] "Das eine oder das andere habe ich selbst erlebt , die anderen meine Schulkameraden ."
## [2] "Huck Finn ist nach dem Leben gezeichnet , nicht weniger Tom Sawyer , doch entspricht dieser nicht einer bestimmten Persönlichkeit , sondern wurde mit charakteristischen Zügen mehrerer meiner Altersgenossen ausgestattet und darf daher jenem gegenüber als einigermaßen kompliziertes psychologisches Problem gelten ."
## [3] "Ich muß hier bemerken , daß zur Zeit meiner Erzählung -- vor dreißig bis vierzig Jahren -- unter den Unmündigen und Unwissenden des Westens noch die seltsamsten , unwahrscheinlichsten Vorurteile und Aberglauben herrschten ."
## [4] "Obwohl dies Buch vor allem zur Unterhaltung der kleinen Welt geschrieben wurde , so darf ich doch wohl hoffen , daß es auch von Erwachsenen nicht ganz unbeachtet gelassen werde , habe ich doch darin versucht , ihnen auf angenehme Weise zu zeigen , was sie einst selbst waren , wie sie fühlten , dachten , sprachen , und welcher Art ihr Ehrgeiz und ihre Unternehmungen waren ."
## [5] "Erstes Kapitel ."
## [6] ", ,Tom !"
Funkcija get_sentiment() dodeli besedam v povedih pozitivno (+1), negativno (-1) ali nevtralno (0) čustveno vrednost. Program te vrednosti sešteje.
tom_values <- get_sentiment(tom_v, method = "nrc", language = "german")
length(tom_values)## [1] 5047
tom_values[100:110]## [1] 0 -2 0 1 0 1 0 0 0 0 0
Povedi, čustvene vrednosti in dolžino povedi povežemo v podatkovni niz. To nam olajšuje oceno, kako uspešna je bila uporaba sentimentnega slovarja v našem besedilu. Preimenovali bomo tudi nekaj stolpcev.
sentiment1 = cbind(tom_v, tom_values, ntoken(tom_v)) %>%
as.data.frame() %>%
rename(words = V3,
text = tom_v,
values = tom_values) %>%
mutate(doc_id = "tom.txt") %>%
rowid_to_column(var = "sentence")
# View(sentiment1)
sentiment1 %>% rmarkdown::paged_table()Gornje postopke ponovimo za besedilo, ki ga želimo primerjati s prvim.
prozess_v = get_sentences(txt$text[1]) # izberemo prvo besedilo: prozess.txt
prozess_v = (prozess_v[-1]) # tako lahko izločimo prvo vrstico (uredniško pripombo)
prozess_values <- get_sentiment(prozess_v, method = "nrc", language = "german")
sentiment2 = cbind(prozess_v, prozess_values, ntoken(prozess_v)) %>%
as.data.frame() %>%
rename(words = V3,
text = prozess_v,
values = prozess_values) %>%
mutate(doc_id = "prozess.txt") %>%
rowid_to_column(var = "sentence")
# View(sentiment2)
sentiment2 %>% rmarkdown::paged_table()S seštevanjem čustvenih vrednosti je mogoče oceniti, katero besedilo ima več pozitivno ocenjenih besed. V ta namen bomo združili podatkovna niza in uredili obliko stolpcev “words” in “values.”
sentiment = rbind(sentiment1, sentiment2) %>% as_tibble() %>%
mutate(values = parse_number(values),
words = parse_number(words)) %>%
dplyr::select(doc_id, sentence, words, values, text)
sentiment %>% rmarkdown::paged_table()Rezultat: po gornji metodi je povprečje čustvenih vrednosti v romanu “Prozess” nekoliko večje kot v romanu “Tom Sawyer.” To je v nasprotju z našim pričakovanjem, saj Tom Sawyer vsebuje kar nekaj vedrih zgodb, je pa res, da so njegove pustolovščine pogosto tudi nevarne ali strašljive.
sentiment %>%
group_by(doc_id) %>%
summarise(polarnost = mean(values))## # A tibble: 2 x 2
## doc_id polarnost
## <chr> <dbl>
## 1 prozess.txt 0.0550
## 2 tom.txt -0.0109
Poskusimo drugače: pozitivne, nevtralne in negativne vrednosti obravnajmo ločeno in upoštevajmo tudi dolžino povedi.
sentiment1 = sentiment %>%
group_by(doc_id) %>%
mutate(positive = ifelse(values > 0, abs(values), 0),
neutral = ifelse(values == 0, 1, 0),
negative = ifelse(values < 0, abs(values), 0))
sentiment1 %>%
summarise(pos = mean(100*positive/words),
neut = mean(100*neutral/words),
neg = mean(100*negative/words))## # A tibble: 2 x 4
## doc_id pos neut neg
## <chr> <dbl> <dbl> <dbl>
## 1 prozess.txt 2.30 4.34 2.13
## 2 tom.txt 2.63 6.77 2.81
Ta rezultat je skladnejši z našim pričakovanjem.
Poglejmo še nekaj povedi, ki so bile ocenjene negativno:
sentiment1 %>%
filter(negative > 0) %>%
rmarkdown::paged_table()6.18.2 Različica 2
tom_v = get_sentences(txt$text[2])
tom_nrc_values = get_nrc_sentiment(tom_v)
tom_joy_items = which(tom_nrc_values$joy > 0)
head(tom_v[tom_joy_items], 4)## [1] "Obwohl dies Buch vor allem zur Unterhaltung der kleinen Welt geschrieben wurde , so darf ich doch wohl hoffen , daß es auch von Erwachsenen nicht ganz unbeachtet gelassen werde , habe ich doch darin versucht , ihnen auf angenehme Weise zu zeigen , was sie einst selbst waren , wie sie fühlten , dachten , sprachen , und welcher Art ihr Ehrgeiz und ihre Unternehmungen waren ."
## [2] ", Spare die Rute , und du verdirbst dein Kind ' , heißt es ."
## [3] "Er ist meiner toten Schwester Kind , ein armes Kind , und ich habe nicht das Herz , ihn irgendwie am Gängelband zu führen ."
## [4] "Es ist wohl hart für ihn , am Samstag stillzusitzen , wenn alle anderen Knaben Feiertag haben , aber er haßt Arbeit mehr als irgend sonst was , und ich will meine Pflicht an ihm tun , oder ich würde das Kind zu Grunde richten ."
nrc_sentiment = as.data.frame(cbind(tom_v, tom_nrc_values))
nrc_sentiment %>% rmarkdown::paged_table()6.18.3 Različica 3
Drugi sentimentni slovarji z medmrežja: npr. BAWLR lahko uporabljamo kot sentimentni slovar.
# This lexicons contains values of Emotional valence and arousal ranging from 1 to 5.
# But this extended version contains also binary Emo_Val values (1, -1).
bawlr <- read.delim2("data/BAWLR_utf8.txt", sep = "\t", dec = ",", fileEncoding = "UTF-8",
header = T, stringsAsFactors = T)
# # bawlr$EmoVal <- as.character(bawlr$EmoVal)
# # str(EmoVal)
# bawlr$EmoVal <- gsub('NEG', '-1', bawlr$EmoVal)
# bawlr$EmoVal <- gsub('POS', '1', bawlr$EmoVal)
# bawlr$EmoVal <- as.numeric(bawlr$EmoVal)
bawlr %>% rmarkdown::paged_table()Sestavimo dva seznama:
positive.words = bawlr %>%
mutate(WORD_LOWER = as.character(WORD_LOWER)) %>%
dplyr::select(EmoVal, WORD_LOWER) %>%
filter(EmoVal == "POS") %>%
dplyr::select(WORD_LOWER) %>%
filter(str_detect(WORD_LOWER, "[a-zA-Z]"))
negative.words = bawlr %>%
mutate(WORD_LOWER = as.character(WORD_LOWER)) %>%
dplyr::select(EmoVal, WORD_LOWER) %>%
filter(EmoVal == "NEG") %>%
dplyr::select(WORD_LOWER) %>%
filter(str_detect(WORD_LOWER, "[a-zA-Z]"))Ustvarimo quanteda slovar dictionary():
bawlr_dict = dictionary(list(positive = list(positive.words), negative = list(negative.words)))Uporabljamo matriko (dfm) s slovarskimi enotami (lemma), saj slovar bawlr_dict vsebujejo le osnovno obliko slovarskih enot.
matrika_lemmas = dfm(matrika_lem, tolower = TRUE)
result = matrika_lemmas %>%
dfm_lookup(bawlr_dict) %>%
convert(to = "data.frame") %>%
as_tibble
result## # A tibble: 2 x 3
## doc_id positive negative
## <chr> <dbl> <dbl>
## 1 prozess.txt 10540540 5856000
## 2 tom.txt 9183068 5425584
Dodamo lahko skupno dolžino besed, če želimo normalizirati rezultat z ozirom na dolžino besedil.
result = result %>% mutate(length=ntoken(matrika_lemmas))
result## # A tibble: 2 x 4
## doc_id positive negative length
## <chr> <dbl> <dbl> <int>
## 1 prozess.txt 10540540 5856000 32058
## 2 tom.txt 9183068 5425584 33520
Po navadi želimo izračunati skupni sentimentno vrednost. Možnosti je več: npr. - odšteti negativne vrednosti od pozitivnih in nato razliko deliti z vsoto obeh vrednosti, - odšteti negativne vrednosti od pozitivnih in nato razliko deliti z dolžino besedil,
Izračunamo lahko tudi stopnjo subjektivnosti, tj. koliko čustvenih vrednosti je skupno izraženih:
result = result %>% mutate(sentiment1=(positive - negative) / (positive + negative))
result = result %>% mutate(sentiment2=(positive - negative) / length)
result = result %>% mutate(subjektivnost=(positive + negative) / length)
result %>% rmarkdown::paged_table()6.18.3.1 Barvno označevanje
Program corpustools barvno označuje besede v besedilih z ozirom na čustvene vrednosti besed v sentimentnem slovarju.
Prvi korak je ustvarjanje tcorpusa.
library(corpustools)
t = create_tcorpus(txt, doc_column="doc_id")V drugem koraku sledi iskanje po slovarju (tcorpus):
t$code_dictionary(bawlr_dict, column = 'bawlr')
t$set('sentiment', 1, subset = bawlr %in% c('positive','neg_negative'))
t$set('sentiment', -1, subset = bawlr %in% c('negative','neg_positive'))Prikaz barvno označenih besedil v oknu “Viewer”:
browse_texts(t, scale='sentiment')Prikaz barvno označenih besedil v spletnem brskalniku in shranjevanje v obliki html datoteke:
browse_texts(t, scale='sentiment', filename = "sentiment_prozess_tom.html",
header = "Sentiment in Kafkas Prozess und Twains Tom Sawyer")